perm filename DPYSUB.SAI[SYS,HE] blob
sn#019450 filedate 1973-01-11 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 ENTRY CALCOMP
00006 00003 ⊃ Declarations for display functions
00010 00004 ⊃ ********* Super wonderful array graphing functions ********
00012 00005 INTERNAL SIMPLE INTEGER PROCEDURE ARRGRF(INTEGER_ARRAY AINTEGER I0,IM,X0,Y0,NX,NYSTRING XUNIT,YUNIT)
00015 00006 SIMPLE PROCEDURE DDOUT(INTEGER_ARRAY DDBUF)
00017 00007 DEFINE DDSIZX="512",DDSIZY="480"
00019 00008 INTERNAL INTEGER GFSIZX,GFSIZY,GFSIZL,X0,Y0,SCALX,SCALY,XCENT,YCENT,LMAR,RMAR,YBOT,CHSCAL
00022 00009 INTERNAL SIMPLE PROCEDURE IIICVT(INTEGER_ARRAY DPYBUF)
00024 ENDMK
⊗;
ENTRY CALCOMP;
BEGIN "DPYSUB"
DEFINE ⊃="COMMENT",REAL_ARRAY="SAFE REAL ARRAY",STRING_ARRAY="SAFE STRING ARRAY",
INTEGER_ARRAY="SAFE INTEGER ARRAY",PICTURE="SAFE INTEGER ARRAY",
SAFE_OWN="PRELOAD_WITH 0;OWN ";
DEFINE PI="3.141592653",PICON="(PI/180)";
⊃ This file contains a collection of useful definitions;
⊃ ****** Picture header definitions;
DEFINE SCALEX="0",SCALEY="1",POSX="2",POSY="3",SIZEX="4",SIZEY="5",
SIZEL="6",PTR="7",NAME="8",BIT="9",GAIN="10",OFFSET="11",PSCALE="10000",PICMAX="11";
⊃ The above definitions refer to locations in a "picture" header.
SCALEX,Y refers to the pixel grid spacing. The original picture has
SCALEX,Y=1. An NxN spacial average would change SCALEX,Y to N.
SIZEX,Y are the X,Y dimensions of the picture.
SIZEL is the # words per line.
POSX,Y are the coordinates of the upper left of the picture.
When extracting windows from a picture, POSX,Y define the
position of the window.
PTR is a byte pointer pointing one before the first pixel in the picture.
BIT is the # bits per pixel.
GAIN and OFFSET describe a linear rescaling of the intensities of each
in the image to best utilize the number of bits per point
which is provided in the array. In particular, GAIN and
OFFSET relate a sample in an image to its "true" light value
as follows:
sample value = GAIN / PSCALE * ("true" light value - OFFSET / PSCALE );
DEFINE HALT="JRST 4,",BOMB="CALL(0,""EXIT"")";
DEFINE XPOINT(S,L,P)="((35-(P))LSH 30)+((S) LSH 24)+(L LAND '777777)";
⊃ XPOINT is the same as point except that the value of L is the location
rather than the address of L;
DEFINE INFINITY="'377777777777";
DEFINE HAT(X,Y)="((((X)-1) DIV (Y)) +1)";
⊃ Declarations for display functions;
EXTERNAL PROCEDURE RVECT(INTEGER X,Y);
EXTERNAL PROCEDURE RIVECT(INTEGER X,Y);
EXTERNAL PROCEDURE RPT(INTEGER X,Y);
EXTERNAL PROCEDURE RPOINT(INTEGER X,Y);
EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
EXTERNAL PROCEDURE APT(INTEGER X,Y);
EXTERNAL PROCEDURE APOINT(INTEGER X,Y);
EXTERNAL PROCEDURE GVECT(INTEGER X,Y,OP,SIZ,BRT);
EXTERNAL INTEGER PROCEDURE AVECW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE AIVECW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE APOINW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE RVECW(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE RPOINW(INTEGER X,Y);
EXTERNAL PROCEDURE DPYSET(INTEGER_ARRAY BUF);
EXTERNAL INTEGER PROCEDURE DPYPARS;
EXTERNAL PROCEDURE DPYRESET(INTEGER BUF);
EXTERNAL INTEGER PROCEDURE GETPOG;
EXTERNAL PROCEDURE RELPOG(INTEGER POG);
EXTERNAL PROCEDURE CLRBFR;
EXTERNAL PROCEDURE HYDPOG(INTEGER POG);
EXTERNAL PROCEDURE DPYOUT(INTEGER POG);
EXTERNAL PROCEDURE TYPLOC(INTEGER P1,P2);
EXTERNAL PROCEDURE NORELOPT;
EXTERNAL PROCEDURE RELOPT;
EXTERNAL PROCEDURE PGSEL(INTEGER POG);
EXTERNAL PROCEDURE UPGMVM(INTEGER VAL;REFERENCE INTEGER ADR);
EXTERNAL INTEGER PROCEDURE UPGMVE(REFERENCE INTEGER ADR);
EXTERNAL PROCEDURE DPYCLR;
EXTERNAL PROCEDURE DPYBIG(INTEGER SIZE);
EXTERNAL PROCEDURE DPYBRT(INTEGER BRT);
EXTERNAL PROCEDURE DPYSST(STRING S);
EXTERNAL INTEGER DPYPTR;
EXTERNAL INTEGER PROCEDURE DPYTST;
EXTERNAL PROCEDURE ACPOGS(INTEGER MASK);
EXTERNAL PROCEDURE ACCPOG(INTEGER POG);
EXTERNAL PROCEDURE DACPOG(INTEGER POG);
EXTERNAL INTEGER POGON;
EXTERNAL INTEGER PROCEDURE GVECW(INTEGER X,Y,OP,SIZ,BRT);
FORWARD INTERNAL SIMPLE PROCEDURE DPYSTR(INTEGER X,Y;STRING STR);
⊃ ********* Super wonderful array graphing functions ********;
INTERNAL SIMPLE INTEGER PROCEDURE MKSCALE(INTEGER X0,Y0;REAL DX,DY,NUMDIST;INTEGER I0,IM;STRING UNITS);
⊃ Draws an axis scale for a graph. X0,Y0 specify the origin of the
graph. DX,DY specify the direction (and scale) of the axis. I0,IM
specify the numeric range of the axis labelling. UNITS is the name
of the axis. Returns the distance between minor "tic" marks on the
axis;
BEGIN INTEGER EX,EY,EI,I,DI,DIN,K;
REAL DL;
DL←ABS(DX)+ABS(DY);
DIN←5;K←1;
WHILE DIN*DL<NUMDIST DO
DIN←DIN*(CASE (K←K+1) MOD 3 OF (2.5,2.0,2.0));
DI←DIN DIV 5;
IF ¬UNITS THEN RETURN(DI);
EX←(-10*DX)/DL;
EY←(-10*DY)/DL;
AIVECT(X0+(IM-I0)*DX,Y0+(IM-I0)*DY);
DPYSST(UNITS);
AIVECT(X0+(IM-I0)*DX,Y0+(IM-I0)*DY);
EI←I0 MOD DI;
IF EI≠0 THEN EI←DI-EI;
X0←X0+EI*DX;
Y0←Y0+EI*DY;
AVECT(X0,Y0);
I0←I0+EI;
FOR I←I0 STEP DI UNTIL IM DO
BEGIN
IF I MOD DIN =0 THEN
BEGIN RVECT(3*EY,3*EX);
DPYSST(CVS(I));
END
ELSE
RVECT(EY,EX);
AIVECT(X0←X0+DI*DX,Y0←Y0+DI*DY);
END;
RETURN(DI);
END "MKSCALE";
INTERNAL SIMPLE INTEGER PROCEDURE ARRGRF(INTEGER_ARRAY A;INTEGER I0,IM,X0,Y0,NX,NY;STRING XUNIT,YUNIT);
⊃ Graphs array A with subscripts in the range I0 to IM, with origin
at X0,Y0 and dimensions NX and NY. The axes are labelled XUNIT and
YUNIT. If I0=IM then the actual array bounds are used for I0 and IM.
NX=0 allows one to overlay a graph on a previous graph, without
relabelling or rescaling the axes;
BEGIN INTEGER I,J,QX,QY,MIN,MAX,X,AI,C,M,XGRID,YGRID,WID,DIG;
REAL DX,DY;LABEL L1;
GETFORMAT(WID,DIG);SETFORMAT(1,0);
IF I0=IM THEN BEGIN I0←ARRINFO(A,1);IM←ARRINFO(A,2) END;
IF NX≠0 THEN ⊃ Own style variables;
BEGIN
MIN←MAX←A[I0];
FOR I←I0+1 STEP 1 UNTIL IM DO ⊃ Determine the min and max;
IF (AI←A[I])>MAX THEN MAX←AI ELSE IF AI<MIN THEN MIN←AI;
DX←NX/(IM-I0);DY←NY/(MAX-MIN); ⊃ Scale the axes;
XGRID←MKSCALE(X0,Y0,DX,0,100,I0,IM,XUNIT);
YGRID←MKSCALE(X0,Y0,0,DY,40,MIN,MAX,YUNIT);⊃ Draw the axes;
QY←YGRID*DY;QX←XGRID*DX;
END;
AIVECT(X0,QY*A[I0] DIV YGRID-QY*MIN DIV YGRID+Y0);
J←I0;
DO BEGIN
M←A[J+1]-A[J];
C←A[J]-M*J;
FOR I←J+2 STEP 1 UNTIL IM DO
IF A[I]≠I*M+C THEN BEGIN I←I-1;GO TO L1 END;
I←IM;
L1: RVECT(QX*I DIV XGRID-QX*J DIV XGRID,QY*A[I] DIV YGRID-QY*A[J] DIV YGRID);
J←I;
END
UNTIL J=IM;
SETFORMAT(WID,DIG);
RETURN(MAX);
END "ARRGRF";
∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w∧w